home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / cadence.arc / VOL2NO1.ARC / DUCT.LSP < prev    next >
Encoding:
Text File  |  1987-05-18  |  3.7 KB  |  134 lines
  1. ;Date:  19-Feb-87 20:32 CST
  2. ;From:  Bill Kramer
  3. ;Subj:  Duct.LSP now rocks in 2.52!
  4.  
  5. ;=====================================================
  6. ;
  7. ;  Revised 2/87  Bill Kramer
  8. ;
  9. ;  Revision for operation under AutoLISP 1.2 (ACAD 2.5+)
  10. ;  Changes to original code in lower case.
  11. ;
  12. ;  Original input of second point works for ACAD version 2.18
  13. ;  which "tricked" AutoLISP into the rubberband.
  14. ;
  15. ;  Additional features added:
  16. ;    Uses upper or lower case.
  17. ;    Shows Centerline of ductwork with GRDRAW which will
  18. ;      vanish when REDRAW is executed.
  19. ;
  20. ;DUCT PROGRAM
  21. (DEFUN LRG ()
  22. ; (COMMAND "DIST" P1) (GETPOINT "\nENTER NEXT POINT :")
  23. ; (COMMAND)
  24. ; (SETQ P2 (GETVAR "LASTPOINT"))
  25.  (setq p2 (getpoint p1 "\nEnter next point:"))
  26.  (SETQ ZD1 (+ (ANGLE P1 P2) 0.26179938))
  27.  (SETQ ZD2 (- (ANGLE P1 P2) 0.26179938))
  28.  (SETQ W2B (* WW 0.5))
  29.  (SETQ WD (- W2B W2))
  30.  (SETQ Z (+ (ANGLE P1 P2) 1.57079633))
  31.  (SETQ P2A (POLAR P2 (+ Z 3.14159265) W2B))
  32.  (SETQ P2B (POLAR P2A Z WW))
  33.  (SETQ P1D (POLAR P1B ZD1 (/ WD (SIN 0.26179938))))
  34.  (SETQ P1C (POLAR P1A ZD2 (/ WD (SIN 0.26179938))))
  35.  (COMMAND "LINE" P1B P1D P1C P1A "")
  36. ; (COMMAND "")
  37.  (SETQ P1 (POLAR P1C Z W2B))
  38.  (SETQ P1A P1C)
  39.  (SETQ P1B P1D)
  40.  (SETQ W2 W2B)
  41.  (SETQ W WW))
  42.  
  43. (DEFUN SML ()
  44. ; (COMMAND "DIST" P1) (GETPOINT "\nENTER NEXT POINT :")
  45. ; (COMMAND)
  46. ; (SETQ P2 (GETVAR "LASTPOINT"))
  47.  (setq p2 (getpoint p1 "\nEnter next point"))
  48.  (SETQ ZD1 (+ (ANGLE P1 P2) 0.26179938))
  49.  (SETQ ZD2 (- (ANGLE P1 P2) 0.26179938))
  50.  (SETQ W2B (* WW 0.5))
  51.  (SETQ Z (+ (ANGLE P1 P2) 1.57079633))
  52.  (SETQ WD (- W2 W2B))
  53.  (SETQ P2A (POLAR P2 (+ Z 3.14159265) W2B))
  54.  (SETQ P2B (POLAR P2A Z WW))
  55.  (SETQ P1D (POLAR P1B ZD2 (/ WD (SIN 0.26179938))))
  56.  (SETQ P1C (POLAR P1A ZD1 (/ WD (SIN 0.26179938))))
  57.  (COMMAND "LINE" P1B P1D P1C P1A "")
  58. ; (COMMAND "")
  59.  (SETQ P1 (POLAR P1C Z W2B))
  60.  (SETQ P1A P1C)
  61.  (SETQ P1B P1D)
  62.  (SETQ W2 W2B)
  63.  (SETQ W WW))
  64.  
  65. (DEFUN WIDE ()
  66.  (SETQ Z (+ (ANGLE P1 P2) 1.57079633))
  67.  (SETQ P2A (POLAR P2 (+ Z 3.14159265) W2))
  68.  (SETQ P2B (POLAR P2A Z W))
  69.  (COMMAND "LINE" P1A P2A "")
  70. ; (COMMAND "")
  71.  (COMMAND "LINE" P1B P2B P2A "")
  72. ; (COMMAND "")
  73.  (SETQ P1 P2)
  74.  (SETQ P1A P2A)
  75.  (SETQ P1B P2B)
  76.  (SETVAR "BLIPMODE" 0)
  77.  (SETQ WW (GETREAL "\nNEXT DUCT WIDTH: "))
  78.  (IF (< WW W) (SML))
  79.  (IF (> WW W) (LRG))
  80. ; (COMMAND "REDRAW")
  81. )
  82. (DEFUN TURN ()
  83. ; (COMMAND "DIST" P2) (GETPOINT "\nENTER NEXT POINT :")
  84. ; (COMMAND)
  85. ; (SETQ P3 (GETVAR "LASTPOINT"))
  86.  (grdraw p1 p2 -1)
  87.  (setq p3 (getpoint p2 "\nEnter next point:"))
  88.  (grdraw p1 p2 -1)
  89.  (SETQ Z1 (ANGLE P2 P1))
  90.  (SETQ Z1X (ANGLE P1 P2))
  91.  (SETQ Z2 (ANGLE P2 P3))
  92.  (SETQ Z2X (+ (* (+ Z1 Z2) 0.5) 3.14159265))
  93.  (SETQ P2B (POLAR P2 Z2X (/ W2 (SIN (- Z2X Z1X)))))
  94.  (COMMAND "LINE" P1B P2B "")
  95. ; (COMMAND "")
  96.  (SETQ P2A (POLAR P2 Z2X (* (/ W2 (SIN (- Z2X Z1X))) -1)))
  97.  (COMMAND "LINE" P1A P2A "")
  98. ; (COMMAND "")
  99.  (SETQ D (/ W 8))
  100. ; (SETQ A (ANGTOS Z2X 1 1))
  101.  (setq A (/ (* Z2X 180.0) pi))
  102.  (COMMAND "INSERT" "VAIN" P2 D "1" A)
  103.  (SETQ P1 P2)
  104.  (SETQ P1A P2A)
  105.  (SETQ P1B P2B)
  106.  (SETQ P2 P3)
  107. )
  108.  
  109. (DEFUN C:DUCT ()
  110.  (SETVAR "CMDECHO" 0)
  111.  (SETQ W (GETREAL "\nPICK DUCT WIDTH: "))
  112.  (SETQ W2 (* W 0.5))
  113.  (SETQ P1 (GETPOINT "\nENTER BEGINNING OF CENTERLINE: "))
  114. ; (COMMAND "DIST" P1) (GETPOINT "\nENTER END OF CENTERLINE: ")
  115. ; (COMMAND)
  116. ; (SETQ P2 (GETVAR "LASTPOINT"))
  117.  (setq p2 (getpoint p1 "\nEnter end of Centerline:"))
  118.  (SETQ Z (+ (ANGLE P1 P2) 1.57079633))
  119.  (SETQ P1A (POLAR P1 (+ Z 3.14159265) W2))
  120.  (SETQ P1B (POLAR P1A Z W))
  121.  (SETQ L T)
  122.  (WHILE L
  123.   (grdraw p1 p2 2)
  124.   (setq test (strcase
  125.              (GETSTRING "\nIS DIRECTION <S>traight or <T>urn <Q>uit ")))
  126.   (IF (EQUAL TEST "S") (WIDE))
  127.   (IF (EQUAL TEST "T") (TURN))
  128.   (IF (EQUAL TEST "Q") (SETQ L NIL)))
  129.  (COMMAND "LINE" P1A P2A P2B P1B "")
  130. ; (COMMAND "")
  131. ; (CLEAN ATOMLIST)
  132.  (redraw)
  133. )
  134.